home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / think-c / tc-exist.el < prev    next >
Encoding:
Text File  |  1994-02-06  |  2.1 KB  |  64 lines  |  [TEXT/EMAC]
  1. (defun tc:file-in-project-p (file-string)
  2.   (let* ((null-desc (make-string sizeof-AEDesc 0))
  3.          have-null-desc
  4.          (file-desc (make-string sizeof-AEDesc 0))
  5.          (reply (make-string sizeof-AppleEvent 0))
  6.          have-file-desc
  7.          (file-obj (make-string sizeof-AEDesc 0))
  8.          have-file-obj
  9.          event
  10.          have-reply
  11.          transactionID
  12.          (result-data (make-string 1 0))
  13.          (result-type (make-string 4 0))
  14.          (result-size (make-string 4 0))
  15.          (result
  16.           (catch 'panic
  17.             (throw-err (create-think-c-apple-event kAECoreSuite kAEDoObjectsExist
  18.                                                    event transactionID))
  19.             
  20.             (throw-err (AECreateDesc typeNull "" 0 null-desc))
  21.             (setq have-null-desc t)
  22.             (throw-err (AECreateDesc typeChar file-string (length file-string) file-desc))
  23.             (setq have-file-desc t)
  24.             (throw-err (CreateObjSpecifier cSourceFile null-desc formName file-desc
  25.                                            0 file-obj))
  26.             (setq have-file-obj t)
  27.             (throw-err (AEPutParamDesc event keyDirectObject file-obj))
  28.             
  29.             (throw-err (AESend event reply (+ kAEWaitReply kAENeverInteract)
  30.                                kAENormalPriority kAEDefaultTimeout
  31.                                AESend-idle-function 0))
  32.             (setq have-reply t)
  33.             
  34.             (throw-err (AEGetParamPtr reply keyAEResult typeBoolean result-type
  35.                                       result-data 1 result-size))
  36.             (not (zerop (extract-internal result-data 0 'char))))))
  37.     
  38.     (if have-null-desc (AEDisposeDesc null-desc))
  39.     (if have-file-desc (AEDisposeDesc file-desc))
  40.     (if have-file-obj (AEDisposeDesc file-obj))
  41.     (if event (AEDisposeDesc event))
  42.     (if have-reply (AEDisposeDesc reply))
  43.     result))
  44.  
  45. (defun tc:relevant-buffers ()
  46.   (let ((old-buffer (current-buffer))
  47.         (result nil)
  48.         (blist (buffer-list)))
  49.     (while blist
  50.       (let* ((buffer (car blist))
  51.              (filename (buffer-file-name buffer)))
  52.         (set-buffer buffer)
  53.                 ;(if tc:have-TPM-data)
  54.                 ;(if (and filename
  55.                 ;         (tc:file-in-project-p (file-name-nondirectory
  56.                 ;                               (buffer-file-name buffer)))))
  57.         (if filename
  58.             (setq result (cons (list buffer (buffer-file-name buffer)
  59.                                      (buffer-modified-p buffer))
  60.                                result)))
  61.         (setq blist (cdr blist))))
  62.     (set-buffer old-buffer)
  63.     result))
  64.